perm filename HEADER.OLD[PNT,HE]2 blob
sn#478462 filedate 1979-09-30 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00010 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 DEFINE VERSION!NUMBER = 9 COMMENT Change this when you are trying to raise
C00003 00003 constants and compile time macros
C00006 00004 ! Default compile flags
C00014 00005 ! global definitions of flags and other constants
C00021 00006 ! record class and pointer definitions
C00026 00007 ! procedure declarations
C00048 00008
C00062 00009 ! variable declarations
C00072 00010 ! file requirements
C00073 ENDMK
C⊗;
DEFINE VERSION!NUMBER = 9 ; COMMENT Change this when you are trying to raise
a new veriosn of POINTY ***** ;
REQUIRE VERSION!NUMBER VERSION;
COMMENT constants and compile time macros;
DEFINE π = "3.141592653";
DEFINE ALT ="'775",
SEMC = "'73",
SP = "'40",
CR = "'15",
LF ="'12",
CRLF = "('15&'12)",
DLF = "('15&'12&'12)",
TAB = "'11",
FF = "'14",
! = "COMMENT ",
TV = "'13",
VERTICAL_TAB="'13",
α = "BEGIN",
β = "END",
RUBOUT = "'177",
DQUOTE = "'42";
DEFINE #DEG = "(3.141592653/180.0)"; ! for radians/degrees conversion;
DEFINE TABDEF "[]" = [" "];
! if /nB is set in the command line then assume he wants a debugging version;
require "<><>" delimiters;
IFC ¬DECLARATION(#DEBUG) THENC
DEFINE
DECIPHER_DEBUG(A)=<
ASSIGNC A=CVMS(COMPILER!BANNER)[2 TO ∞-1];
ASSIGNC A=CVPS(A)[LENGTH(SCANC(CVPS(A), LF, NULL, "IA"))+1 FOR ∞];
ASSIGNC A=CVPS(A)[LENGTH(SCANC(CVPS(A), TAB, NULL, "IA"))+1 FOR ∞];
ASSIGNC A=CVPS(A)[LENGTH(SCANC(CVPS(A), SP, NULL, "IA"))+1 FOR 1];
"A">;
IFC DECIPHER_DEBUG()="0"
THENC DEFINE #DEBUG=FALSE;
ELSEC DEFINE #DEBUG=TRUE;
EXTERNAL PROCEDURE BAIL;
EXTERNAL STRING !!QUERY;
ENDC
ENDC
DEFINE RCLASS "<>" = <RECORD_CLASS>;
DEFINE RPTR "<>" = <RECORD_POINTER>;
DEFINE RANY "<>" = <RECORD_POINTER(ANY_CLASS)>;
DEFINE REQUIRE_LOADMODULE(FLAG, FILE) "<>" =
< IFC FLAG THENC
REQUIRE "FILE" LOAD_MODULE;
ENDC > ;
! Default compile flags;
IFCR NOT DECLARATION(#HELP) THENC DEFINE #HELP = TRUE; ENDC
! the program is compiled without
help facilities (?, complete error explanations,
syntax of the istructions..);
IFCR NOT DECLARATION(#WRIST) THENC DEFINE #WRIST = TRUE; ENDC
IFCR NOT DECLARATION(#GATHER) THENC DEFINE #GATHER = TRUE; ENDC
IFCR NOT DECLARATION(#DISPL) THENC DEFINE #DISPL = TRUE; ENDC
! the program is without the display;
IFCR NOT DECLARATION(#OUTPT) THENC DEFINE #OUTPT = TRUE; ENDC
! the progaam is without file I/O;
ifcr not declaration(#nofunct) thenc define #nofunct = true; endc
IFCR NOT DECLARATION(#INPUT) THENC DEFINE #INPUT = TRUE; ENDC
! the program is without arm interface;
IFCR NOT DECLARATION(#ARROW) THENC DEFINE #ARROW = FALSE; ENDC
ifcr not declaration(#move) thenc define #move= true; endc
IFC ¬ #DISPL THENC REDEFINE #ARROW=FALSE; ENDC
DEFINE #INDEF = 0; ! #INDEF for not defined direction in input;
DEFINE #SORRY "<>" = <("sorry, not implemented "&CRLF)>;
! used for non implemented parts message;
DEFINE #NOTYET "<>" = <("yarm not yet available "&CRLF)>;
! used for non implemented parts message;
DEFINE #VERSION "<>" = <("instruction not available in this POINTY version "&CRLF)>;
! used for different version message;
IFCR NOT DECLARATION($MSM) THENC DEFINE $MSM = FALSE; ENDC
IFCR NOT DECLARATION($MLG) THENC DEFINE $MLG = FALSE; ENDC
IFCR NOT DECLARATION($MSM) THENC DEFINE $MSM = FALSE; ENDC
IFCR NOT DECLARATION($MAINPR) THENC DEFINE $MAINPR = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($SYMBOL) THENC DEFINE $SYMBOL = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($SCANNER) THENC DEFINE $SCANNER = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($$HELP) THENC DEFINE $$HELP = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($PARSE) THENC DEFINE $PARSE = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($PCODE) THENC DEFINE $PCODE = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($PPROC2) THENC DEFINE $PPROC2 = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($PPROC) THENC DEFINE $PPROC = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($OUTPUT) THENC DEFINE $OUTPUT = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($FORMAT) THENC DEFINE $FORMAT = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($DISPLY) THENC DEFINE $DISPLY = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($INIT) THENC DEFINE $INIT = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($EXPR) THENC DEFINE $EXPR = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($EXEC) THENC DEFINE $EXEC = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($EXPR$) THENC DEFINE $EXPR$ = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($TALK11) THENC DEFINE $TALK11 = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($GATHER) THENC DEFINE $GATHER = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($PPCODE) THENC DEFINE $PPCODE = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($UTIL) THENC DEFINE $UTIL = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($PCALL) THENC DEFINE $PCALL = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($PNEW) THENC DEFINE $PNEW = FALSE;
ELSEC DEFINE INVALID_ID=FALSE; ENDC
IFCR NOT DECLARATION($ALTER_EGO) THENC DEFINE $ALTER_EGO=FALSE; ENDC
IFCR NOT DECLARATION(INVALID_ID) THENC
REQUIRE "
********** MODULE DOESN'T HAVE KNOWN ID ********************
" MESSAGE;
ENDC
DEFINE DECLAR_VAR(DEC,I,E) "<>" =
IFCR $ALTER_EGO THENC
< IFC I THENC INTERNAL DEC ; ELSEC
EXTERNAL DEC ; ENDC > ;
ELSEC
< IFC I THENC INTERNAL DEC ; ELSEC
IFC E THENC EXTERNAL DEC ; ENDC ENDC > ;
ENDC
DEFINE DECLAR_PREDEFINED_ARRAY(VAL,DEC,I,E) "<>" =
IFCR $ALTER_EGO THENC
< IFC I THENC VAL ; INTERNAL DEC ; ELSEC
EXTERNAL DEC ; ENDC > ;
ELSEC
< IFC I THENC VAL ; INTERNAL DEC ; ELSEC
IFC E THENC EXTERNAL DEC ; ENDC ENDC > ;
ENDC
DEFINE DECLAR_PROC(DEC,I,E) "<>" =
IFCR $ALTER_EGO THENC
< IFC I THENC FORWARD INTERNAL DEC ; ELSEC
EXTERNAL DEC ; ENDC > ;
ELSEC
< IFC I THENC FORWARD INTERNAL DEC ; ELSEC
IFC E THENC EXTERNAL DEC ; ENDC ENDC > ;
ENDC
! global definitions of flags and other constants;
DEFINE #MIN = 1;
DEFINE #MAX = 9;
DEFINE #NTYPE = #MAX; ! 8 data types= 8 classes of records;
DEFINE #LTYPE = 70; ! number of elements for each type;
DEFINE #BASIC_TYPES=6; ! seventh not used now;
DEFINE DUMMY_DELIM=RUBOUT; ! used to delimit macro parameters;
DEFINE #SC = 1; ! SCALAR ;
DEFINE #VT = 2; ! VECTOR ;
DEFINE #RT = 3; ! ROT ;
DEFINE #TR = 4; ! TRANS ;
DEFINE #FRE= 4; ! frame expression ;
DEFINE #FR = 5; ! FRAME ;
DEFINE #EV = 6; ! EVENT ;
DEFINE #CM = 7; ! CONDITION MONITOR ;
DEFINE #MC = 8; ! MACRO ;
DEFINE #FN = 9; ! FUNCTION ;
! DEFINE #EX =10; ! EXPRESSION ;
! DEFINE #SY =11; ! SYMBOL ;
DEFINE #DTYPE= 12; ! # OF DATATYPES, INCREASE IF MORE RECORDS DEFINED;
DEFINE #PR = #FN;
DEFINE #SIMPLE = 0; ! access for different identifiers;
DEFINE #ARRAY = 1;
DEFINE #PROCEDURE = 2 ;
DEFINE #ARRAY_ELEMENT = 3 ;
DEFINE #ELSE =-1; ! used for else in CASE;
! codes for source of input ;
DEFINE TTY_X=1; ! TTY input ;
DEFINE DSK_X=2 ; ! DSK input ;
DEFINE QUERY_X=3 ; ! QUERY input ;
DEFINE MESSAGE_X=4; ! MESSAGE input by MAIL from other prog ;
DEFINE MAC_X=5; ! output from macro body;
DEFINE PROGRAM_X=6; ! input from program body;
! codes for terminal type;
DEFINE OTHER_TTY=0; ! terminal is some other kind;
DEFINE DD_TTY=1; ! terminal is a datadisc;
DEFINE DM_TTY=2; ! terminal is a datamedia;
DEFINE III_TTY=3; ! terminal is a III;
DEFINE CTY_TTY=4; ! terminal is P1 console tty;
DEFINE DET_TTY=5; ! job is detached;
DEFINE MAX_TTY=5; ! this is the largest number;
! codes for output from the program ;
DEFINE WR_M = 1; ! DSK output for macros;
DEFINE ED_M = 2; ! TTY output for editing macros;
DEFINE DS_M = 3; ! TTY output for displaying macros;
DEFINE TABLE_D=1,
FILE_D=2,
TYPE_D=3,
EDIT_D=4,
SYMBOL_D=5;
DEFINE ID_TYPE = 1; ! #TOKEN values: identifier;
DEFINE INT_TYPE = 2; ! integer;
DEFINE REAL_TYPE = 3; ! real;
DEFINE OPERATOR_TYPE = 4; ! operators;
DEFINE RES_TYPE = 5; ! reserved type;
DEFINE UNDECLARED_TYPE = 0; ! none of the above;
DEFINE #INDLK = 0; ! affix type = independent link;
DEFINE #NRGLK = 1; ! affix type = non rigid link;
DEFINE #RGDLK = 2; ! affix type = rigid link;
DEFINE MAX_OFFSET=1; ! max allowable offset ;
DEFINE CUR_OFFSET=2; ! current offset ;
DEFINE CON_OFFSET=3; ! constant offsets end here;
DEFINE ARM_OFFSET=4; ! arm offset starts here;
DEFINE PRG_OFFSET=5; ! program defined variables begin here;
DEFINE RES_OFFSET=6; ! reserved words table entries end here;
DEFINE #SCLTYP = 1; ! data type codes defined in the AL runtime system;
DEFINE #VECTYP = 2;
DEFINE #TRNTYP = 3;
DEFINE #EVNTYP = 4;
DEFINE #CMNTYP = 5;
DEFINE #HDRTYP = '400; ! Pointer to frame header ;
DEFINE #ARRTYP = '1000; ! Pointer to array header ;
DEFINE #REFTYP = '2000; ! Indirect pointer to entry in another environment;
DEFINE #PRCTYP = '4000; ! Pointer to procedure descriptor ;
DEFINE #MINUS1 = '177777; ! PDP11 representation of -1 ;
DEFINE #NONRGD = '400; ! code for nonrigid affixment;
DEFINE #EXPTRN = '2000; ! code for explicit trans used ;
! codes defined in the AL interpreter code;
DEFINE YRM_ALOFFSET=0,
YHD_ALOFFSET=1,
BRM_ALOFFSET=2,
BHD_ALOFFSET=3; ! level offsets for the four devices;
! codes necessary for the arm code;
DEFINE YARM_MECH = "'1";
DEFINE YHAND_MECH = "'2";
DEFINE BARM_MECH = "'4";
DEFINE BHAND_MECH = "'10";
DEFINE AHAND_MECH = "'12";
DEFINE ANARM_MECH = "'5";
DEFINE YARMSB = "'176000";
DEFINE YHANDSB = "'1000";
DEFINE BARMSB = "'770";
DEFINE BHANDSB = "'4";
DEFINE ABS_MOTION="0";
DEFINE REL_MOTION="1";
DEFINE YELLOW="0";
DEFINE BLUE = "1";
IFC $TALK11 OR $EXEC OR $PNEW OR $ALTER_EGO THENC
REQUIRE "ELFDEF[PNT,HE]" SOURCE_FILE;
ENDC
! record class and pointer definitions;
DECLAR_VAR(<RCLASS SYMBOL (STRING PNAME;
RANY OBJECT; ! rptr for further info;
INTEGER TYPE, ! #SC,#VT,#RT,#TR,#FR,#EV,#MC,#PR(UNTYPED);
ACCESS, ! #SIMPLE,#ARRAY,#PROCEDURE;
OFFSET, ! level offset ;
INDEX ! array index for simple variables ;
! INTEGER NUSEDBY,NUSES;
! BOOLEAN VALID; ! RANY ARRAY USEDBY,USES;)>,
$SYMBOL, NOT $SYMBOL);
DECLAR_VAR(<RPTR(SYMBOL)ARRAY $YMTAB[1:#NTYPE,1:#LTYPE]>,
$SYMBOL, $OUTPUT∨$DISPLY∨$FORMAT∨$PPROC);
DECLAR_VAR(<RCLASS SYMTREE(RPTR(SYMBOL)SYM;
RPTR(SYMTREE)LLINK,RLINK)>, $SYMBOL, $SCANNER∨$EXPR∨$PPROC∨$MAINPR);
DECLAR_VAR(<RCLASS BLOCKREC(RPTR(SYMTREE)TREE;
RPTR(BLOCKREC)NEXT;
INTEGER LEVEL,#ARGS)>, $SYMBOL, $SCANNER∨$EXPR∨$PPROC∨$MAINPR);
DECLAR_VAR(<RPTR(BLOCKREC) CURBLOCK>, $SYMBOL, $SCANNER∨$EXPR∨$PPROC∨$MAINPR);
DECLAR_VAR(<INTEGER ARRAY $ENTRY[1:#NTYPE]>, $SYMBOL, $OUTPUT∨$DISPLY∨$INIT∨$FORMAT∨$PPROC);
DECLAR_VAR(<RCLASS SCALAR (REAL VALUE)>, $SYMBOL, ¬ $SYMBOL);
DECLAR_VAR(<RCLASS VECTOR (REAL XC,YC,ZC)>, $SYMBOL, ¬ $SYMBOL);
DECLAR_VAR(<RCLASS FRAME (STRING PNAME;
RPTR (FRAME) DAD,SON,EBRO,YBRO; INTEGER HOWLINKED;
REAL ARRAY XF;
RPTR(SYMBOL)SYM)>, $SYMBOL, ¬ $SYMBOL);
DECLAR_VAR(<RCLASS ROT (REAL ARRAY XF)>, $SYMBOL, ¬ $SYMBOL);
DECLAR_VAR(<RCLASS TRANS(REAL ARRAY XF)>, $SYMBOL, ¬ $SYMBOL);
DECLAR_VAR(<RCLASS GRAPHREC(REAL ARRAY DATA;
INTEGER SIZE,CTLBITS,NPNTS)>, $SYMBOL,$EXEC∨$GATHER∨$PCALL);
DECLAR_VAR(<RPTR(GRAPHREC) GRAPTR>, $SYMBOL, $EXEC∨$GATHER∨$PCALL);
DECLAR_VAR(<RCLASS WRISTREC(INTEGER ARRAY DATA)>, $SYMBOL, $EXEC∨$MAINPR);
DECLAR_VAR(<RPTR(WRISTREC)WSTPTR>, $SYMBOL, $EXEC∨$MAINPR);
DECLAR_VAR(<RCLASS ARRAYREC(INTEGER #DIM,#EL; INTEGER ARRAY LB,UB,MUL;
RPTR(SYMBOL) ARRAY PTR)>, $SYMBOL, ¬$SYMBOL);
DECLAR_VAR(<RCLASS EXPR$(INTEGER #BODY,TYPE;INTEGER ARRAY BODY)>,
$EXPR, not $EXPR);
DECLAR_VAR(<RCLASS MACRO(STRING HEAD,BODY;INTEGER NPARAM;
STRING ARRAY PRLIST)>, $SYMBOL, ¬ $SYMBOL);
DECLAR_VAR(<RCLASS PROC(INTEGER NARGS;
STRING HEAD,BODY;STRING ARRAY ARGNAME;
INTEGER ARRAY ARGDIM,ARGTYPE,ARGACCS)>, $SYMBOL, ¬ $SYMBOL);
DECLAR_VAR(<RCLASS CASE$ (INTEGER NUM;RPTR(EXPR$) BODY;RPTR(CASE$) NEXT)>,
$PPROC, $PCODE);
DECLAR_VAR(<RPTR(SYMBOL)CURPROC>, $SYMBOL, $EXPR∨$SCANNER∨$PCODE∨$PPROC∨$MAINPR);
! pointers to predeclared symbols;
DECLAR_VAR(<RPTR(SYMBOL)HANDB,HANDY>, $SYMBOL, $INIT∨$EXPR);
DECLAR_VAR(<RPTR(SYMBOL)BARM,YARM,BPARK,YPARK,BGRASP>, $SYMBOL, $INIT∨$EXPR);
DECLAR_VAR(<RPTR(SYMBOL)WORLD>, $SYMBOL, $INIT∨$OUTPUT∨$EXPR∨$PPROC);
DECLAR_VAR(<RPTR(FRAME)F_BARM,F_YARM,F_ARM>, $SYMBOL, $INIT);
DECLAR_VAR(<RPTR(FRAME)F_WRLD>, $SYMBOL, $INIT∨$DISPLY∨
$MAINPR∨$OUTPUT∨$EXEC∨$PPROC);
! procedure declarations ;
! **** MAIN PROGRAM PROCEDURES ****** ;
DECLAR_PROC(<procedure outdpw (string mess; integer string_pos, pp_pos)>,
FALSE, $MAINPR∨$PCALL∨$$HELP);
DECLAR_PROC(<PROCEDURE BAILCODE>, $MAINPR, $PCALL);
DECLAR_PROC(<PROCEDURE QBAILCODE>, $MAINPR, $PCALL);
DECLAR_PROC(<PROCEDURE ERROR(STRING ERR1,ERR2(NULL))>, $MAINPR, ¬ $MAINPR);
DECLAR_PROC(<PROCEDURE CHKESC_I>, $MAINPR, $SCANNER∨$TALK11);
DECLAR_PROC(<SIMPLE PROCEDURE ESC_I>, $MAINPR, $SCANNER∨$INIT);
! ****** SYMBOL PROCEDURES *******;
DECLAR_PROC(<RPTR(FRAME) PROCEDURE FR_INSERT (REFERENCE STRING SYMB)>,
$SYMBOL, $MAINPR∨$PCALL);
DECLAR_PROC(<RPTR(SYMBOL) PROCEDURE CHECK(STRING SYMB; INTEGER NM)>,
$SYMBOL, $MAINPR∨$INIT∨$PPROC2∨$PCODE);
DECLAR_PROC(<RPTR(SYMBOL) PROCEDURE CHECKTOT(STRING SYMB)>,
$SYMBOL, $SCANNER∨$PPROC);
DECLAR_PROC(<RPTR (SYMBOL) PROCEDURE ENSYM(STRING SYMB;INTEGER NM;
RANY VAL;RPTR(SYMBOL)OLDREC(NULL_RECORD);
INTEGER ACCESS(#SIMPLE))>, $SYMBOL, $MAINPR∨$INIT∨$PPROC∨$PCALL);
DECLAR_PROC(<PROCEDURE ENSYM$(RPTR(SYMBOL)SYM; INTEGER NM(0))>,
$SYMBOL, $PPROC∨$PCALL);
DECLAR_PROC(<INTERNAL STRING PROCEDURE NEWSYM(STRING SYMB)>,
$SYMBOL, $MAINPR∨$PCALL);
DECLAR_PROC(<RPTR(SYMBOL) PROCEDURE OLDSYM(REFERENCE STRING SYMB;REFERENCE INTEGER OBTYPE)>,
$SYMBOL,$MAINPR∨$PCALL);
DECLAR_PROC(<INTERNAL PROCEDURE DELSYM(RPTR(SYMBOL)EL)>,$SYMBOL,$MAINPR∨$PCALL);
DECLAR_PROC(<RPTR(SYMBOL)PROCEDURE MK_SYM(STRING PNAME; INTEGER TYPE;
RANY PTR(NULL_RECORD); INTEGER ACCESS(#SIMPLE))>,$SYMBOL,$MAINPR∨$PPROC);
DECLAR_PROC(<PROCEDURE INSRTSYMTREE(RPTR(SYMBOL)S;RPTR(BLOCKREC)STREE)>,
$SYMBOL,$MAINPR∨$PPROC);
DECLAR_PROC(<RPTR(BLOCKREC)PROCEDURE BLOCKIFY(INTEGER NARGS; RPTR(SYMBOL)ARRAY SYMARR;
RPTR(BLOCKREC)BLOCK(NULL_RECORD))>, $SYMBOL,$MAINPR∨$PPROC);
DECLAR_PROC(<RPTR(SYMBOL)PROCEDURE SEARCHBLOCK(STRING S; RPTR(BLOCKREC)R)>,
$SYMBOL,$MAINPR∨$SCANNER);
DECLAR_PROC(<RPTR(SCALAR,VECTOR,ROT,TRANS,FRAME) PROCEDURE MK_REC(INTEGER TYPE)>,
$SYMBOL,$INIT∨$EXEC);
DECLAR_PROC(<RPTR(PROC)PROCEDURE MK_PR(INTEGER ARGS; STRING ARRAY ARGNAME;
INTEGER ARRAY ARGTYPE,ARGACCS,ARGDIM)>, $SYMBOL,$PPROC);
DECLAR_PROC(<PROCEDURE PR_SAVE(RPTR(PROC)PSYM;STRING SAVEBODY)>,
$SYMBOL,$PPROC);
DECLAR_PROC(<RPTR(FRAME) PROCEDURE GTFRAME(INTEGER LEVOFF,#DIM; INTEGER ARRAY DIM;
RPTR(SYMBOL)S)>, $SYMBOL,$MAINPR∨$EXEC);
DECLAR_PROC(<INTERNAL INTEGER PROCEDURE ARRYDIM(INTEGER LEVOFF;
REFERENCE RPTR(SYMBOL) SYM)>, $SYMBOL,$MAINPR∨$EXEC∨$PPCODE);
DECLAR_PROC(<RPTR(SYMBOL)PROCEDURE NNWR(STRING SYMB; INTEGER TYP;
INTEGER ACCESS(0))>, $SYMBOL,$MAINPR∨$PPROC);
DECLAR_PROC(<RPTR(SYMBOL)PROCEDURE NWAREC(RPTR(SYMBOL)TEMP;INTEGER #EL;
INTEGER ARRAY LB,UB,MULT)>, $SYMBOL,$EXEC∨$PPROC);
DECLAR_PROC(<RPTR(SYMBOL)PROCEDURE CNVRTR(RPTR(SYMBOL)EL;STRING SYMB)>,
$SYMBOL,$MAINPR∨$PPROC);
DECLAR_PROC(<RANY PROCEDURE BELONGS(REFERENCE STRING SYMB; INTEGER OBTYPE)>,
$SYMBOL,$MAINPR∨$EXPR∨$PPROC2∨$PCALL);
DECLAR_PROC(<RPTR(SYMBOL) PROCEDURE INSERT(STRING SYMB;INTEGER OBTYPE)>,
$SYMBOL,$MAINPR∨$PPROC);
DECLAR_PROC(<PROCEDURE KILLVAR(RPTR(SYMBOL)EL)>, $SYMBOL,$PCALL);
DECLAR_PROC(<BOOLEAN PROCEDURE PRDECL(RPTR(SYMBOL) OB1)>,$SYMBOL,$PPROC∨$PCALL);
DECLAR_PROC(<PROCEDURE RESET>, $SYMBOL,$MAINPR∨$PPROC∨$PCALL);
DECLAR_PROC(<PROCEDURE UFX_NODE(RPTR(FRAME)EL1,EL2)>, $SYMBOL,$MAINPR∨$EXEC);
DECLAR_PROC(<PROCEDURE AFX_NODE(RPTR(FRAME)N,D;INTEGER HOW)>, $SYMBOL,$MAINPR∨$EXEC);
DECLAR_PROC(<PROCEDURE LINKFR(RPTR(FRAME) N,D)>, $SYMBOL,$PPROC);
! **** FEXPR PROCEDURES ******* ;
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE PREF(RPTR(SYMBOL)S)>, $EXPR, $PCODE∨$PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE IDREF(REFERENCE RPTR(SYMBOL)S)>,$EXPR, $MAINPR∨$PCODE∨$PPROC∨$PCALL);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE AREF(RPTR(SYMBOL)S;INTEGER OPERATION)>,
$EXPR, $MAINPR∨$PCODE);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $$GTEXPR>, $EXPR, $MAINPR∨$PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $$GTIDREF(INTEGER TYPE;
REFERENCE RPTR(SYMBOL)SYM; STRING S)>, $EXPR,$MAINPR∨$PPROC);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $$GTANYEXP(STRING S;INTEGER TYPE)>,
$EXPR,$PPROC∨$PPROC2);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $APPEND(RPTR(EXPR$)E1,E2; INTEGER TYPE(0))>,
$EXPR, ¬ $EXPR);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $AAPPEND(RPTR(EXPR$) ARRAY APTR;INTEGER TYPE(0))>,
$EXPR, ¬ $EXPR);
DECLAR_PROC(<SIMPLE PROCEDURE IPUSH(INTEGER J)>, $EXPR, $PCODE);
DECLAR_PROC(<SIMPLE PROCEDURE FPUSH(REAL R)>, $EXPR,$PCODE∨$PPROC);
DECLAR_PROC(<PROCEDURE GPUSH(RPTR(SYMBOL)S)>, $EXPR,$PCODE);
DECLAR_PROC(<PROCEDURE CPUSH(RPTR(SYMBOL)S)>, $EXPR,$PCODE);
DECLAR_PROC(<PROCEDURE PPUSH(RPTR(SYMBOL)S)>, $EXPR,$PCODE);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE αEXPR$(INTEGER ARRAY BUFF;INTEGER #TYPE(0))>,
$EXPR,$PCODE∨$INIT∨$PPROC2);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE EXPR$1(INTEGER I(0))>,$EXPR,$MAINPR∨$PCODE∨$EXEC∨$PPROC∨$pproc2);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE EXPR$2(INTEGER I(0),J(0))>,
$EXPR,$MAINPR∨$PCODE∨$EXEC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE EXPR$3(INTEGER I(0),J(0),K(0))>,
$EXPR,$MAINPR∨$PCODE∨$EXEC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE EXPR$R(RPTR(SYMBOL)S)>,$EXPR,$PCODE∨$EXEC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE EXPR$G(RPTR(SYMBOL)S)>,$EXPR,$PCODE∨$EXEC);
DECLAR_PROC(<RPTR (EXPR$)PROCEDURE βEXPR$(INTEGER TYPE(0))>,$EXPR,$PCODE∨$PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE NEXPR(INTEGER SIZE,ARG1)>,$EXPR,$PCODE);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE EXPR$ID(RPTR(SYMBOL)S)>,$EXPR,$PPROC∨$PCODE);
DECLAR_PROC(<INTEGER PROCEDURE EXPR$OFF(RPTR(EXPR$)ARRAY ARR; INTEGER I,J)>,
$EXPR,$PCODE);
! *** SCANNER PROCEDURES **** ;
DECLAR_PROC(<RECURSIVE PROCEDURE GTOKEN(BOOLEAN NONSTOP(TRUE))>,
$SCANNER, $MAINPR∨$init∨$EXPR∨$PPROC∨$PPROC2∨$PARSE∨$PCALL);
! if response is left out ASKUSER will wait for terminal input;
DECLAR_PROC(<PROCEDURE ASKUSER(STRING RESPONSE(null))>, $SCANNER, $MAINPR∨$OUTPUT∨$INIT∨$EXPR∨$PCODE∨$PPROC2∨$PCALL);
DECLAR_PROC(<PROCEDURE PUSHDEVSTACK>, $SCANNER, $MAINPR∨$PPROC∨$PCALL);
DECLAR_PROC(<PROCEDURE POPDEVSTACK>, $SCANNER, $MAINPR∨$PPROC∨$PCALL);
DECLAR_PROC(<PROCEDURE MTYDEVSTACK>, $SCANNER, $MAINPR∨$init∨$PPROC);
DECLAR_PROC(<PROCEDURE NEWLINE>, $SCANNER, $MAINPR);
DECLAR_PROC(<SIMPLE BOOLEAN PROCEDURE FINAL>, $SCANNER, $MAINPR∨$PPROC∨$PPROC2∨$PCALL);
DECLAR_PROC(<SIMPLE PROCEDURE READTO(STRING S)>, $SCANNER, $MAINPR∨$PPROC∨$PARSE);
DECLAR_PROC(<SIMPLE INTEGER PROCEDURE READTILL(STRING CHARS)>, $SCANNER, $MAINPR∨$PPROC∨$PCALL);
DECLAR_PROC(<STRING PROCEDURE NAMEFILE>, $SCANNER, $MAINPR∨$OUTPUT∨$PPROC∨$PCALL∨$PARSE);
DECLAR_PROC(<INTEGER PROCEDURE POSINT_READ>, $SCANNER, $PPROC);
ifc false thenc
DECLAR_PROC(<SIMPLE STRING PROCEDURE FROMPART>, $SCANNER, $MAINPR);
DECLAR_PROC(<SIMPLE STRING PROCEDURE DEV_READ>, $SCANNER, $MAINPR);
endc
DECLAR_PROC(<SIMPLE STRING PROCEDURE ARM_READ>, $SCANNER, $PPROC2);
DECLAR_PROC(<SIMPLE STRING PROCEDURE HAND_READ>, $SCANNER, $PPROC2);
DECLAR_PROC(<SIMPLE PROCEDURE SEMICOL_READ>, $SCANNER, $MAINPR∨$PPROC∨$PCALL);
DECLAR_PROC(<SIMPLE PROCEDURE WORD_READ(STRING S)>, $SCANNER, $MAINPR∨$PPROC∨$PPROC2∨$PCALL);
DECLAR_PROC(<SIMPLE STRING PROCEDURE MVFR_READ>, $SCANNER, $MAINPR∨$PPROC2);
DECLAR_PROC(<SIMPLE STRING PROCEDURE IDF_READ>, $SCANNER, $MAINPR∨$PPROC2∨$PPROC∨$PCALL);
! **** OUTPUT PROCEDURES **** ;
IFC $MAINPR∨$FORMAT∨$OUTPUT∨$DISPLY∨$PCALL∨$ALTER_EGO THENC
DECLAR_PROC(<STRING PROCEDURE CVSSYM(RPTR(SYMBOL)SYM; INTEGER MODE(TABLE_D))>,
$FORMAT,$OUTPUT∨$MAINPR∨$DISPLY∨$PCALL);
DECLAR_PROC(<STRING PROCEDURE CVSYM(RPTR(SYMBOL)SYM; INTEGER MODE(TABLE_D))>,
$FORMAT,$OUTPUT∨$MAINPR∨$DISPLY∨$PCALL);
DECLAR_PROC(<STRING PROCEDURE CVEXPR(RPTR(EXPR$)EX; INTEGER MODE(TABLE_D))>,
$FORMAT,$PCALL);
ENDC
! ***** DISPLY ROUTINES ***** ;
IFC $DISPLY∨($MAINPR∧(#OUTPT∨#DISPL))∨$ALTER_EGO∨$INIT∨$PCALL THENC
DECLAR_PROC(<PROCEDURE DPYOUT(INTEGER POG)>, FALSE∧$DISPLY, (#OUTPT∨#DISPL)∧$MAINPR∨$PCALL);
DECLAR_PROC(<SIMPLE PROCEDURE INIDPY>, $DISPLY, #OUTPT∨#DISPL∨$INIT);
DECLAR_PROC(<SIMPLE PROCEDURE DPYDRAW>, $DISPLY, #OUTPT∨#DISPL∨$PCALL);
DECLAR_PROC(<SIMPLE PROCEDURE DPYFREE>, $DISPLY, #OUTPT∨#DISPL∨$PCALL);
DECLAR_PROC(<SIMPLE PROCEDURE OUTDPY>, $DISPLY, #OUTPT∨#DISPL∨$PCALL);
DECLAR_PROC(<STRING PROCEDURE DPY_STRING(INTEGER TYPE)>, $DISPLY, #OUTPT∨#DISPL∨$PCALL);
DECLAR_PROC(<RECURSIVE STRING PROCEDURE FRTREE(RPTR(FRAME) ND;INTEGER DEPTH)>,
$DISPLY, #OUTPT∨#DISPL);
! # of characters for frame tree;
DECLAR_VAR(<INTEGER $NCHAR>, $DISPLY, #OUTPT∨#DISPL);
ENDC
! ****** $OUTPUT ROUTINES ******* ;
IFC ($MAINPR∧#OUTPT)∨$OUTPUT∨$DISPLY∨$PPROC∨$PCALL∨$ALTER_EGO THENC
DECLAR_PROC(<PROCEDURE WRITECODE(STRING FILE;
RPTR(SYMBOL) ELEMENT)>, $OUTPUT, #OUTPT∨$PCALL);
DECLAR_PROC(<PROCEDURE TTYSAVE(STRING FILE)>, $OUTPUT, #OUTPT∨$PPROC);
DECLAR_PROC(<STRING PROCEDURE FILE_STRING>, $OUTPUT, #OUTPT∨$PCALL);
ENDC
IFC FALSE THENC
DECLAR_PROC(<PROCEDURE UDATEFILE(INTEGER CHAN)>, $OUTPUT, $SCANNER);
ENDC
! ******* INIT ROUTINES ********** ;
DECLAR_PROC(<PROCEDURE INIT>, $INIT, $MAINPR);
DECLAR_PROC(<PROCEDURE ENDIT>, $INIT, $PPROC∨$PCALL);
DECLAR_PROC(<PROCEDURE PRESWAP>, $INIT, $UTIL);
DECLAR_PROC(<PROCEDURE POSTSWAP>, $INIT, $UTIL);
! ******** WRIST ROUTINES *************;
DECLAR_PROC(<INTEGER PROCEDURE RWRIST(STRING COMMAND; INTEGER VAL(0);
STRING FILENAME(NULL))>, FALSE, ($PPROC∨$MAINPR)∧#WRIST);
! ********* MSSNGR ROUTINES ***********;
DECLAR_PROC(<PROCEDURE EVAL(RPTR(EXPR$)EE)>, $TALK11, $EXEC);
DECLAR_PROC(<PROCEDURE ALINIT>, $TALK11, $INIT∨$PCALL);
DECLAR_PROC(<PROCEDURE VT05>, $TALK11,$PCALL);
DECLAR_PROC(<PROCEDURE CONSOLE>, $TALK11,$PCALL);
DECLAR_PROC(<PROCEDURE UNCONSOLE>, $TALK11,$PCALL);
DECLAR_PROC(<PROCEDURE RES11(INTEGER ARRAY MEM)>, $TALK11,$PCALL);
DECLAR_PROC(<PROCEDURE RESTRT11(INTEGER STRADR('1000))>, $TALK11,$PCALL∨$INIT);
DECLAR_PROC(<PROCEDURE SAV11(INTEGER ARRAY MEM)>, $TALK11,$PCALL);
! ********* GATHER ROUTINES ************ ;
DECLAR_PROC(<PROCEDURE GRAPH(REAL ARRAY RDATA; INTEGER CTL,NPTS,SIZE)>,
FALSE, $MAINPR∨#GATHER);
! ********* PPCODE ROUTINES ************* ;
DECLAR_PROC(<PROCEDURE PPCODE(RPTR(EXPR$)EE;INTEGER SNUM(1))>, $PPCODE,$EXEC∨$MAINPR);
! ********** UTIL ROUTINES *************** ;
DECLAR_PROC(<SIMPLE INTEGER PROCEDURE COMPEQU(STRING S1,S2)>, $UTIL, $MAINPR∨$PARSE∨$SYMBOL);
DECLAR_PROC(<STRING PROCEDURE DAT_STR>, $UTIL, $OUTPUT∨#OUTPT);
DECLAR_PROC(<PROCEDURE WRITEFILE(STRING FILE,MSSGE)>, $UTIL, $PCALL);
DECLAR_PROC(<PROCEDURE DELFILE(STRING FILE)>, $UTIL, $PCALL);
DECLAR_PROC(<STRING PROCEDURE FILENAME(INTEGER CHAN)>, $UTIL,FALSE);
DECLAR_PROC(<PROCEDURE UDATEFILE(INTEGER CHAN)>, $UTIL, $OUTPUT∨$SCANNER);
DECLAR_PROC(<PROCEDURE ADDFILE(STRING FILE, S)>, $UTIL,$OUTPUT);
DECLAR_PROC(<PROCEDURE CRAFILE(INTEGER CHAN)>, $UTIL,$OUTPUT∨$INIT);
DECLAR_PROC(<INTEGER PROCEDURE OWRITEFILE(STRING FILE;INTEGER MODE(0))>,
$UTIL,$PPROC);
DECLAR_PROC(<STRING PROCEDURE READFILE(STRING FILE;INTEGER MODE(0))>,
$UTIL,$MAINPR∨$PCALL);
DECLAR_PROC(<BOOLEAN PROCEDURE FILE_ABSENT(STRING FNAME)>, $UTIL,$PPROC);
DECLAR_PROC(<INTEGER PROCEDURE OREADFILE(STRING FILE;REFERENCE INTEGER EOF;
INTEGER MODE(0))>,
$UTIL, $PCALL∨$PPROC);
DECLAR_PROC(<SIMPLE STRING PROCEDURE CVTAB(STRING OLD_STRING)>, $UTIL, $$HELP);
DECLAR_PROC(<INTEGER PROCEDURE ORAFILE(STRING FILE,S(NULL);
BOOLEAN ERROR_RETURN(TRUE))>, $UTIL,$OUTPUT∨$INIT);
DECLAR_PROC(<SIMPLE INTEGER PROCEDURE LOGIN(STRING PPN(NULL))>, $UTIL,FALSE);
DECLAR_PROC(<PROCEDURE MONITOR(STRING COMMAND,PPN(NULL))>, $UTIL,$INIT);
DECLAR_PROC(<PROCEDURE LOGOUT(INTEGER PTYLINE)>, $UTIL,FALSE);
DECLAR_PROC(<PROCEDURE FLTOUT(REAL FNUM; REFERENCE INTEGER XNUM1,XNUM2)>,
$UTIL,$PCODE∨$EXPR);
DECLAR_PROC(<REAL PROCEDURE RFVAL(INTEGER WORD1,WORD2)>, $UTIL,$EXPR∨$TALK11∨$PPCODE);
DECLAR_PROC(<REAL PROCEDURE RFVAL0(INTEGER WORD)>, $UTIL,$TALK11);
DECLAR_PROC(<PROCEDURE BRK_N>, $UTIL,$PPROC∨$INIT∨$MAINPR∨$PCALL);
DECLAR_PROC(<PROCEDURE ESC_P>, $UTIL,TRUE);
DECLAR_PROC(<BOOLEAN PROCEDURE SWAP0(INTEGER ARRAY SAVADR,GETADR,ACCUM)>,
$UTIL,$PCALL);
DECLAR_PROC(<STRING PROCEDURE TTYTYPE>, $UTIL,$INIT);
DECLAR_PROC(<SIMPLE INTEGER PROCEDURE IOWD(INTEGER N,LOC)>, $UTIL,$TALK11);
DECLAR_PROC(<SIMPLE PROCEDURE CALLM(INTEGER OP,AC,ADDR)>, $UTIL,$TALK11);
DECLAR_PROC(<SIMPLE PROCEDURE CALLV0(STRING UUO; INTEGER AC,ADDR)>, $UTIL,$TALK11);
DECLAR_PROC(<SIMPLE PROCEDURE CALLV(STRING UUO; INTEGER ADDR)>, $UTIL,$TALK11);
DECLAR_PROC(<SIMPLE INTEGER PROCEDURE CALLU0(STRING UUO;INTEGER AC;
REFERENCE INTEGER ADDR)>, $UTIL,$TALK11);
DECLAR_PROC(<SIMPLE INTEGER PROCEDURE CALLU(STRING UUO;
REFERENCE INTEGER ADDR)>, $UTIL,$TALK11);
DECLAR_PROC(<SIMPLE PROCEDURE REASSI(INTEGER JOB; STRING DEVICE)>,
$UTIL,$INIT);
! ******** EXEC ROUTINES ******** ;
DECLAR_PROC(<RECURSIVE PROCEDURE $EXECUTE(RPTR(EXPR$)CUEXPR)>,
$EXEC, $MAINPR∨$INIT∨$PARSE∨$PPROC);
DECLAR_PROC(<PROCEDURE $EVLARR(RPTR(SYMBOL)SYM)>, $EXEC, $OUTPUT);
DECLAR_PROC(<RANY PROCEDURE $EVALEXP(RPTR(EXPR$)EX)>, $EXEC, $FORMAT);
DECLAR_PROC(<RANY PROCEDURE $EVAL11(RPTR(SYMBOL)SYM)>, $EXEC, $FORMAT∨$PPROC);
DECLAR_PROC(<RECURSIVE RPTR(EXPR$) PROCEDURE $ELFEVAL(RPTR(EXPR$)CUEXPR)>,
$EXEC, $EXPR);
! ******* PCODE ROUTINES *********** ;
ifc $PCODE∨$PPROC∨$ALTER_EGO thenc
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $COORDPCODE(RPTR(EXPR$)E1,E2;INTEGER ELEMENT,TYPE)>,
$PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $KVARPCODE(INTEGER N)>, $PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $RFORCEPCODE>, $PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $RTNPCODE(RPTR(EXPR$)EXP)>, $PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $ARRDCLPCODE(RPTR(EXPR$) ARRAY BOUNDS;
INTEGER OBTYPE,ADIM,OFFSET)>, $PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $PRCDCLPCODE(RPTR(SYMBOL)SYM;
RPTR(EXPR$)PBODY)>, $PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $WRISTPCODE(RPTR(SYMBOL)S)>,
$PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $SETBASEPCODE>, $PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $GATHERPCODE(INTEGER STATUS)>,
$PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $SETSTFPCODE>, $PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $VT05PCODE(INTEGER STATE)>,
$PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $ABORTPCODE>, $PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $PROMPTPCODE>, $PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $DDTPCODE>, $PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $AFXPCODE(RPTR(EXPR$)SON,DAD; INTEGER AFFCODE;
RPTR(EXPR$)E1)>, $PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $UFXPCODE(RPTR(EXPR$) SON,DAD)>,
$PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $PRPCODE(STRING S)>, $PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $PRVPCODE(RPTR(EXPR$)EE)>, $PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $COBEGPCODE(RPTR(EXPR$)ARRAY PTR)>,
$PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $IFPCODE(RPTR(EXPR$) COND,A,B(NULL))>,
$PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $WHILEPCODE(RPTR(EXPR$)COND,STAT)>,
$PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $DOPCODE(RPTR(EXPR$)S,B)>, $PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $FORPCODE(RPTR(SYMBOL)K;RPTR(EXPR$)I1,I2,I3,S)>,
$PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE L$SIMPCODE(RPTR(SYMBOL)PTR;
INTEGER TYPE;RPTR(EXPR$)EXP)>, $PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE L$ARRPCODE(RPTR(SYMBOL)PTR;
INTEGER TYPE;RPTR(EXPR$)EXP)>, $PCODE, $PPROC);
endc
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $SMPDCLPCODE(INTEGER OBTYPE,J)>,
$PCODE, $PPROC∨$INIT);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $CENTERPCODE(INTEGER ARM)>, $PCODE, $PPROC∨$PPROC2);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $MOVEPCODE(RPTR(SYMBOL) S1,S2;RPTR(EXPR$)ARRAY FDESTS;
INTEGER NFDEST)>, $PCODE, $PPROC2);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $DRIVEPCODE(INTEGER COLOR;STRING HOW;
INTEGER JOINT;RPTR(EXPR$)SCAL)>, $PCODE, $PPROC2);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $ASGPCODE(RPTR(EXPR$) LHS,RHS)>,
$PCODE, $MAINPR∨$PPROC);
DECLAR_PROC(<PROCEDURE $FFRCPCODE(REFERENCE RPTR(EXPR$)HEADER,HEAD,TAIL;
RPTR(EXPR$)EXP,ACTION;INTEGER BITS,DEVBITS,OFFSET)>,
$PCODE,$PPROC2);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $FRCPCODE(RPTR(EXPR$)E,EXP,ACTION;INTEGER BITS,DEVBITS)>,
$PCODE,$PPROC2);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $STOPPCODE(INTEGER BITS)>, $PCODE,$PPROC2);
DECLAR_PROC(<RPTR(EXPR$)PROCEDURE $CASEPCODE(RPTR(EXPR$) EXI;RPTR(CASE$) EXC;
BOOLEAN READELSE;INTEGER MAX)>, $PCODE, $PPROC);
DECLAR_PROC(<RPTR(EXPR$) PROCEDURE $SIGWAITPCODE(RPTR(EXPR$)EVENT;
BOOLEAN SIGNAL)>, $PCODE, $PPROC);
! ********* PPROC2 ROUTINES ******** ;
ifc $PPROC∨$PPROC2∨$PARSE∨$ALTER_EGO thenc
DECLAR_PROC(<PROCEDURE CLOSEPROC>, $PPROC2,$PARSE);
DECLAR_PROC(<PROCEDURE STOPPROC>, $PPROC2, $PARSE);
DECLAR_PROC(<PROCEDURE PARKINGPROC>, $PPROC2, $PARSE);
DECLAR_PROC(<PROCEDURE AXMOVPROC>, $PPROC2, $PARSE);
DECLAR_PROC(<PROCEDURE DRIVEPROC>, $PPROC2, $PARSE);
DECLAR_PROC(<PROCEDURE CENTERPROC>, $PPROC2, $PARSE);
DECLAR_PROC(<PROCEDURE MOVEPROC>, $PPROC2, $PARSE);
DECLAR_PROC(<PROCEDURE JTMOVE(STRING WHAT,HOW;INTEGER JOINT)>,
$PPROC2, $PARSE∨$PPROC);
DECLAR_PROC(<PROCEDURE ALONGPROC(STRING AXIS,FRA1)>, $PPROC2, $PARSE∨$PPROC);
DECLAR_PROC(<PROCEDURE PTOPROC>, $PPROC2, $PARSE∨$PPROC);
DECLAR_PROC(<PROCEDURE PBYPROC>, $PPROC2, $PARSE∨$PPROC);
DECLAR_PROC(<PROCEDURE ONPROC(RPTR(EXPR$)E(NULL_RECORD))>,$PPROC2, $PARSE);
DECLAR_PROC(<PROCEDURE OPENING(STRING FIRST,WHAT,HOW)>, $PPROC2, $PARSE∨$PPROC);
DECLAR_PROC(<PROCEDURE OPCLPROC(STRING FIRST)>, $PPROC2, $PARSE);
endc
ifc false thenc
DECLAR_PROC(<PROCEDURE OPCLCODE(STRING OP,HAND,HOW;RPTR(EXPR$)SCAL)>,
$PPROC2, $MAINPR);
endc
! ****** PCALL ********* ;
ifc $PCALL∨$PARSE∨$ALTER_EGO thenc
DECLAR_PROC(<PROCEDURE DEFINECALL(BOOLEAN REDEF(FALSE))>,$PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE DELETECALL(BOOLEAN QUIET(FALSE))>,$PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE EXITCALL>, $PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE BAILCALL>, $PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE QBLCALL>, $PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE SETSTATUSCALL(INTEGER VARVALUE)>,$PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE READMESSCALL>, $PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE STOPMESSCALL>, $PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE EDITCALL>, $PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE RENAMCALL>, $PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE EEDITCALL>, $PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE GRAPHCALL>, $PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE READCALL(BOOLEAN ECHO(TRUE))>, $PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE WRITCALL>, $PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE REDISPLAYCALL>, $PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE NODISPLAYCALL>, $PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE DISPLAYCALL>, $PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE SHOWCALL>, $PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE PHOTOCALL(STRING FILE)>, $PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE HELPCALL>, $PCALL,$PARSE);
DECLAR_PROC(<PROCEDURE SAVECORECALL(STRING FILE)>, $PCALL,$PARSE);
endc
DECLAR_PROC(<PROCEDURE READCODE(STRING FID; BOOLEAN ECHO(FALSE))>,
$PCALL, $INIT);
DECLAR_PROC(<PROCEDURE UPDATE>, $PCALL,$SCANNER∨$PARSE∨$MAINPR∨$INIT);
DECLAR_PROC(<PROCEDURE RENEW>, $PCALL,$SCANNER);
DECLAR_PROC(<PROCEDURE NOTAVAILCALL>, $PCALL,$PARSE∨$MAINPR);
! ****** PPROC ***** ;
ifc $PPROC∨$PARSE thenc
DECLAR_PROC(<RECURSIVE PROCEDURE BEGINPROC>, $PPROC,$PARSE);
DECLAR_PROC(<RECURSIVE PROCEDURE COBEGINPROC>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE ENDPROC(STRING E("END"))>, $PPROC,$PARSE);
DECLAR_PROC(<RECURSIVE PROCEDURE IFPROC>, $PPROC,$PARSE);
DECLAR_PROC(<RECURSIVE PROCEDURE FORPROC>, $PPROC,$PARSE);
DECLAR_PROC(<RECURSIVE PROCEDURE WHILEPROC>, $PPROC,$PARSE);
DECLAR_PROC(<RECURSIVE PROCEDURE DOPROC>, $PPROC,$PARSE);
DECLAR_PROC(<RECURSIVE PROCEDURE CASEPROC>, $PPROC, $PARSE);
DECLAR_PROC(<PROCEDURE PROCDECLPROC(INTEGER OBTYPE(#PR))>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE SIMPLEDECL(INTEGER OBTYPE)>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE ARRAYDECLPROC(INTEGER OBTYPE)>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE DECLPROC (INTEGER OBTYPE)>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE RETURNPROC>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE SETBASEPROC>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE WRISTPROC>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE GATHERPROC>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE READWRISTPROC>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE SETSTIFFPROC>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE DDTPROC>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE VT05PROC(INTEGER STATE)>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE PRINTPROC>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE ABORTPROC>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE PROMPTPROC>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE UNFIXPROC>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE AFFIXPROC>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE COORDPROC (INTEGER ELEMENT,TYPE)>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE ASSIGNPROC>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE DEFLT(STRING HOW)>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE SIGWAITPROC(BOOLEAN SIGNAL)>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE DUMPPROC(STRING FILE)>, $PPROC,$PARSE);
DECLAR_PROC(<PROCEDURE LOADPROC(STRING FILE)>, $PPROC,$PARSE);
endc
DECLAR_PROC(<PROCEDURE ASGEX2(RPTR(SYMBOL)S;RPTR(EXPR$)LHS)>,
$PPROC,$PCALL∨$PARSE);
! ********* PARSE ROUTINES ********* ;
DECLAR_PROC(<RECURSIVE RPTR(EXPR$)PROCEDURE PARSE>,
$PARSE, $INIT∨$PPROC2∨$MAINPR∨$PPROC);
DECLAR_PROC(<INTEGER PROCEDURE DECSTR(STRING S)>, $PARSE, $SCANNER);
! ******** PNEW ROUTINE ********** ;
DECLAR_PROC(<PROCEDURE FOOCALL(INTEGER I)>, $PNEW,$PARSE);
! ******** HELP ROUTINE ******** ;
DECLAR_PROC(<PROCEDURE HELP>, $$HELP,$PCALL);
! variable declarations ;
! **** BREAK TABLES ****** ;
DECLAR_VAR(<INTEGER $RETAB,$SKTAB,$SPCTAB,$SCNTAB,$NUMTAB,$ALFTAB,$FFTAB,
$DSHTAB,$LTTAB,$NLTTAB>, $MAINPR, $SCANNER∨$INIT∨$PPROC∨$PCALL);
DECLAR_VAR(<INTEGER $DPYTAB>, $MAINPR, $SCANNER∨$INIT∨$DISPLY);
DECLAR_VAR(<INTEGER $ERRTAB>, $MAINPR, $SCANNER∨$OUTPUT∨$INIT∨$SYMBOL);
DECLAR_VAR(<INTEGER $BSKTAB,$RBTAB,$CRTAB>, $MAINPR, $SCANNER∨$OUTPUT∨$INIT∨$FORMAT∨$PCALL);
! **** DEFAULT MOVE FROM PREVIOUS **** ;
DECLAR_VAR(<STRING OLDOBJ,OLDCMD>, $MAINPR, $SCANNER∨$PPROC2∨$PPROC∨$PCALL);
! **** I/O TO POINTY ******* ;
! ESCAPE_I FLAG;
DECLAR_VAR(<BOOLEAN $ESC_I>, $MAINPR, $SCANNER∨$INIT∨$TALK11);
! true if no calls to EVAL after last escape_I;
DECLAR_VAR(<BOOLEAN $ELFABORTED>, $MAINPR, $TALK11∨$FORMAT∨$PPROC);
! true if ELF unavailable;
DECLAR_VAR(<BOOLEAN $NOELF,$ELFUNAVAILABLE>, $TALK11, $EXEC∨$PCALL);
! if true output is required;
DECLAR_VAR(<BOOLEAN $OUT,$SYSOUT>, $MAINPR, $SCANNER∨$OUTPUT∨$INIT∨$PCALL∨$SYMBOL);
! if true read from disk file ;
DECLAR_VAR(<INTEGER $TTYCH,$SYSCH>, $MAINPR, $SCANNER∨$OUTPUT∨$INIT∨$PCALL∨$SYMBOL);
! name of file for teletype input ;
DECLAR_VAR(<STRING $TTYFL,$SYSFL>, $MAINPR, $OUTPUT∨$INIT∨$DISPLY);
! last file used for output ;
DECLAR_VAR(<STRING $ALFL>, $MAINPR, $OUTPUT∨$INIT∨$PPROC∨$PCALL);
! current i/o device ;
DECLAR_VAR(<INTEGER DEVICE,$TTYTYPE>, $MAINPR, $SCANNER∨$INIT∨$PPROC∨$PCALL∨$SYMBOL∨$$HELP∨$TALK11);
! end of file ? ;
DECLAR_VAR(<INTEGER $EOF>, $MAINPR, $SCANNER∨$OUTPUT∨$PCALL);
! input channel for file input ;
DECLAR_VAR(<INTEGER $INPCH>, $MAINPR, $SCANNER∨$PCALL);
DECLAR_VAR(<INTEGER !PPCODE>, $MAINPR, $EXEC∨$PPROC∨$PCALL);
DECLAR_VAR(<INTEGER !LINE>, $MAINPR, $SCANNER∨$PCALL);
! **** DISPLAY ***** ;
! vertical position of the arrow;
DECLAR_VAR(<INTEGER $ARROW>, $MAINPR, $DISPLY∨$PPROC);
! flag to update display ;
DECLAR_VAR(<INTEGER $ALLOW,$UPDATED>, $MAINPR, $SCANNER∨$INIT∨$PARSE∨$PCALL∨$SYMBOL);
! strings for various parts of the display ;
DECLAR_VAR(<STRING ARRAY $DISPLAYLIST[#MIN:#MAX+#BASIC_TYPES]>, $MAINPR, NOT $MAINPR);
DEFINE $SCLST= <$DISPLAYLIST[#SC]>,
$VTLST= <$DISPLAYLIST[#VT]>,
$RTLST= <$DISPLAYLIST[#RT]>,
$TRLST= <$DISPLAYLIST[#TR]>,
$FRLST= <$DISPLAYLIST[#FR]>,
$EVLST= <$DISPLAYLIST[#EV]>,
$CMLST= <$DISPLAYLIST[#CM]>,
$FNLST= <$DISPLAYLIST[#FN]>,
$MCLST= <$DISPLAYLIST[#MC]>;
DECLAR_VAR(<STRING $OULST,$DFLST>, $MAINPR, $OUTPUT∨$DISPLY∨$EXPR∨$PPROC∨$PCALL);
! **** SCANNER VARIABLES AND PARAMETERS **** ;
! the token itself ;
DECLAR_VAR(<STRING TOKEN>, $MAINPR, NOT $MAINPR);
! type of last token read by GTOKEN;
DECLAR_VAR(<INTEGER #TOKEN>, $MAINPR, $SCANNER∨$EXPR∨$PPROC∨$PPROC2∨$PCALL);
! index telling what type of reserved word ;
DECLAR_VAR(<integer res_class>, $SCANNER, $MAINPR∨$PPROC∨$PARSE);
! true if the next token to be read is yet in TOKEN;
DECLAR_VAR(<BOOLEAN STOKEN>, $MAINPR, $SCANNER∨$INIT∨$EXPR∨$PCODE∨$PPROC∨$PPROC2∨$PARSE∨$PCALL);
! more info on TOKEN ;
DECLAR_VAR(<INTEGER TOKENCLASS,TOKENINDEX,TOKENLEVEL>, $MAINPR, $SCANNER∨$EXPR∨$PPROC∨$PARSE);
! pointer to relevant record in the symbol table ;
DECLAR_VAR(<RPTR(SCALAR,SYMBOL) TOKENPTR>, $MAINPR, $SCANNER∨$PPROC∨$EXPR∨$PCALL);
! current and remaining part of current line ;
DECLAR_VAR(<STRING $CLNE,$CLINR,$CLNSAVE>, $MAINPR, $SCANNER∨$OUTPUT∨$PPROC2∨$PPROC∨$PCALL);
! prevent macro expansion;
DECLAR_VAR(<BOOLEAN NOEXPAND>, $MAINPR, $SCANNER∨$PPROC∨$PARSE∨$PCALL);
! output * or ****>>> depending on new statement ;
DECLAR_VAR(<BOOLEAN STBEGIN>, $MAINPR, $SCANNER∨$PPROC∨$PARSE);
! do we want to print out the file being read in? ;
DECLAR_VAR(<BOOLEAN NEWFILE,FILEPRINT>, $MAINPR, $SCANNER∨$PPROC∨$PARSE∨$PCALL);
! ****** SYMBOL TABLE VARIABLES *** ;
DECLAR_VAR(<INTEGER ARRAY OFFSET[1:6,#MIN:#MAX]>, $SYMBOL,$INIT∨$DISPLY∨$OUTPUT∨$PPROC);
DECLAR_VAR(<INTEGER $SYMOFF,$TSCOFF,$TTROFF>, $MAINPR,$INIT∨$PCODE∨$PPROC∨$PCALL);
! ****** flag to indicate if compile or interpret ********* ;
DECLAR_VAR(<INTEGER $TMPOFF,$LEVEL,$COMPILE>, $MAINPR,$PPROC∨$PCODE∨$PARSE∨$PCALL);
DECLAR_VAR(<RPTR(EXPR$)$$PCODE>, $MAINPR,$PPROC∨$PPROC2∨$PARSE);
! ***** MISCELLANEOUS VARIABLES ******* ;
DECLAR_VAR(<INTEGER $HELP>, $MAINPR, $PPROC2∨$PPROC);
DECLAR_VAR(<REAL $EPS>, $MAINPR, $INIT∨$FORMAT);
DECLAR_VAR(<STRING $BLANK>, $MAINPR, $OUTPUT∨$INIT∨$DISPLY);
DECLAR_VAR(<INTEGER $BRCHR>, $MAINPR, $OUTPUT∨$FORMAT∨$PPROC2∨$PPROC∨$PCALL∨$SYMBOL);
DECLAR_VAR(<STRING ARRAY $WRMSG[1:3]>, #WRIST∧FALSE,$PPROC∧#WRIST);
DECLAR_PREDEFINED_ARRAY(<PRELOAD_WITH 0,#SCLTYP,#VECTYP,#TRNTYP,#TRNTYP,#TRNTYP,
#EVNTYP,#CMNTYP,0,0>,
<INTEGER ARRAY OBTYPES[0:#MAX]>, $EXPR, $PCODE);
DECLAR_PREDEFINED_ARRAY(<PRELOAD_WITH NULL,"SCALAR","VECTOR","ROT","TRANS","FRAME",
"EVENT","CONDITION_MONITOR","MACRO","PROCEDURE", "SCALAR PROCEDURE","VECTOR PROCEDURE",
"ROT PROCEDURE","TRANS PROCEDURE","FRAME PROCEDURE","EVENT PROCEDURE">,
<STRING ARRAY $DTYPE[0:#MAX+#BASIC_TYPES]>, $SYMBOL,$PCALL∨$PPROC);
DECLAR_PREDEFINED_ARRAY(<PRELOAD_WITH "OTHER","DD","DM","III","CTY","DET">,
<STRING ARRAY $TTYNAME[0:MAX_TTY]>, $INIT, $$HELP∨$OUTPUT);
DECLAR_PREDEFINED_ARRAY(<PRELOAD_WITH 60,35,23,36,30,30>,
<INTEGER ARRAY LASTLINE[0:MAX_TTY]>, $INIT, $OUTPUT∨$$HELP∨$TALK11);
! *** buffers and variables for communicating with elf **** ;
DECLAR_VAR(<INTEGER ARRAY $INBUF[1:IBUFFSIZ],TMPBUF[1:FBUFFSIZ]>,
$TALK11, $EXEC);
DECLAR_VAR(<REAL ARRAY $FPBUF[1:FBUFFSIZ]>, $TALK11, $EXEC);
DECLAR_VAR(<INTEGER $FPSIZ,$INTSIZ,$INTPTR,$FPPTR>, $TALK11, $EXEC);
DECLAR_VAR(<INTEGER $INTMAX,$FPMAX,$PCDMAX>, $TALK11, $INIT);
DECLAR_VAR(<INTEGER ALEVENTOFF>, $INIT, $EXPR∧FALSE);
DECLAR_VAR(<INTEGER ARRAY ARROFF[#SC:#EV]>, $SYMBOL, $TALK11∨$INIT∨$EXPR);
! DECLAR_VAR(<INTEGER ARRAY VAROFF[#SC:#EV]>, $MAINPR, $TALK11∨$INIT∨$EXPR);
! *** global SAIL variables ***** ;
DECLAR_VAR(<INTEGER _SKIP_>, FALSE, $UTIL∨$TALK11);
! file requirements;
! source files;
IFC $EXPR∨$PPCODE∨$PCODE∨$EXEC∨$PPROC2∨$PPROC∨$PNEW THENC
REQUIRE "INTOPS.SAI" SOURCE_FILE;
DEFINE II=0;
DEFINE MAKEOP(OPNUM,OPNAM,OPVAL)"[]"=
[ REDEFINE II = II + 2 ;
DEFINE OPNUM = II ; ];
! *********** ; INTOPS ! ************* ;
DEFINE #ALINTOPS = II ;
ENDC
REdefine
preload_array(name, defs, type, first, len)"[][]"=[
preload_with defs null; type array name[first:first+len] ];
IFC $EXPR ∨ $PARSE ∨$PNEW THENC
REQUIRE "OPDECL.SAI[PNT,HE]" SOURCE_FILE;
ENDC
REQUIRE "[][]" DELIMITERS;